home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
doors_2
/
twview93.zip
/
MOREPAIR.INC
< prev
next >
Wrap
Text File
|
1992-06-08
|
5KB
|
139 lines
function match( classification : str3; s : sector) : boolean;
{ return true when port in sector s matches the classification }
const
powertwo : array [1..3] of integer = (1, 2, 4);
var
ThisPort : stuff;
matchall : boolean;
i : 1..3;
begin
matchall := false;
ThisPort := space.sectors[s].porttype;
if length( classification ) <> 3 then
writeln('error -- wrong length of string passed to "match"')
else if ThisPort = NotAPort then
writeln('error -- matched called on sector that isn''t a port')
else if ThisPort <> Class0 then
begin
matchall := true;
for i := 1 to 3 do
case classification[i] of
'B' : matchall := matchall and ( ThisPort and powertwo[i] = 0);
'S' : matchall := matchall and ( ThisPort and powertwo[i] <> 0);
'X' : ;
else
writeln('error: bad character in classification passed to "match"');
end; {case}
end;
match := matchall;
end;
procedure AddPortsInsideRadius( CurrentSector : sector;
matchtype : str3;
HowFar : integer;
var MasterList : sectorList );
{ add all ports to "master list" that match the described "match type"
within "How Far" of "Current Sector". }
var
t : warpindex;
begin
if space.sectors[ currentSector ].porttype <> NotAPort then
if match( matchtype, CurrentSector ) then
AddToList( MasterList, currentSector );
if HowFar > 0 then {recurse}
begin
for t := 1 to space.sectors[ CurrentSector ].number do
AddPortsInsideRadius( space.sectors[ CurrentSector ].data[ t ],
matchtype, howFar - 1, MasterList );
end;
end;
function SearchForPair( ShowLevels : boolean;
baseSector : sector;
destination : str3;
limit : integer ) : integer;
var
s : sector;
FoundPorts : sectorlist;
i : sectorindex;
lines : integer;
g, g1 : stuff;
f : text; {dummy}
begin
FoundPorts.size := 0;
lines := 0;
g := space.sectors[baseSector].porttype;
AddPortsInsideRadius( baseSector, destination, limit, FoundPorts );
if FoundPorts.size > 0 then
begin
write('Base point ', baseSector:4);
write( ' ', status( g ) );
if space.sectors[ baseSector].etc and HasFighters <> Nothing then
write(' F');
if space.sectors[ BaseSector].etc and SpaceLane <> Nothing then
write(' SL');
writeln(' ', DisplayPort(portNumber(baseSector)));
lines := lines + 1;
for i := 1 to FoundPorts.size do
begin
s := FoundPorts.data[i];
g1 := space.sectors[s].porttype;
write('Pair: ', s:4);
write(' (', FixPath( s, baseSector ):1, ')');
write(' ', status( g1 ) );
if space.sectors[ s ].etc and HasFighters <> Nothing then
write(' F');
writeln(' ', DisplayPort(portNumber(s)));
if ShowLevels then
PortTradeFactor( baseSector, s, deal( g, g1), deal( g1, g ),
true, false, f );
lines := lines + 1;
end;
end; {if}
SearchForPair := lines;
end;
procedure PairSearch( target, destination : str3 );
{ this will look for ports of type "target" (wildcards allowed) to type
"destination".}
var
linecount, { number of lines printed this screen }
lines : integer; { number of lines printed this search }
NumSectors : sectorindex;
maxDist : integer;
i : sector;
candidates : sectorlist;
response : string;
showfactor : boolean;
begin
linecount := 0;
SortPorts( NumSectors );
candidates.size := 0;
for i := 1 to NumSectors do
if match( target, distances[i].s) then
AddToList( candidates, distances[i].s );
write('Maximum distance for pair? [0 to abort] ');
readln( maxDist );
showFactor := prompt('Show port trade factors? ');
if maxdist > 0 then
for i := 1 to candidates.size do
begin
lines := SearchForPair( showfactor, candidates.data[i], destination,
maxDist );
if lines > 0 then
begin
linecount := linecount + lines;
if showFactor then
linecount := linecount + (lines - 1); {one factor level per line}
if linecount > 10 then
begin
writeln;
if prompt('enough? ') then
exit;
linecount := 0;
end {if linecount}
else
writeln;
end; {if lines}
end; {if match}
end;